perm filename APE[AP,SYS]2 blob sn#014826 filedate 1972-12-01 generic text, type C, neo UTF8
COMMENT ⊗   VALID 00030 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00004 00002	Definitions.
C00007 00003	More definitions.
C00010 00004	Storage allocations for statistics keeping.
C00012 00005	Storage allocations.
C00017 00006	Beginning of main program (APE): read in the AP system files.
C00022 00007	Start of main loop: asking for keywords.  (RSTART,RESET,APE1)
C00027 00008	Process keyword expression.
C00032 00009	Tell user how many stories were found and ask him which ones he wants to select.
C00037 00010	Read in story selection numbers and build up sublist of selected stories.
C00041 00011	Continue building up a list of the stories selected.
C00047 00012	Find out where the news should be directed: tty, spooler, and/or a file.
C00050 00013	LOOKUP output file to see if it already exists.  Then ENTER output file.
C00054 00014	Read in the stories found: TYPEM1, TYPEM.
C00058 00015	Type out and/or file stories.  Then close and/or spool output file, if any.
C00064 00016	Subroutines: TERM, FACTOR, PRIMAR.
C00068 00017	Search the dictionary for the specified keyword.
C00071 00018	Subroutines: FOUND, FINWD, NOMULT.
C00073 00019	Subroutines: READWD.
C00076 00020	Subroutines: GETCH, GETAVL, NOTFND, NONE, ERROR.
C00080 00021	Subroutines: SETUP, NEXT1, NEXT2.
C00082 00022	Subroutines: SDIFF.
C00083 00023	Subroutines: UNION.
C00084 00024	Subroutines: INTER.
C00085 00025	Subroutines: COPY1,COPY2,FINISH.
C00087 00026	Subroutines: LATEST, SEQNBR.
C00091 00027	Subroutines: GETSTY, INNBR, GETNBR, NXTDG, INTRPT.
C00094 00028	Subroutines: PUTDAT.
C00096 00029	Subroutines: PRINTU. (Printing of statistics)
C00099 00030	Subroutines: SAVPPN.
C00101 ENDMK
C⊗;
;Definitions.

	TITLE APE

;ACCUMULATOR ASSIGNMENTS
FLAGS←←0		;AC0 contains flags in the left half and "@" in the right half
A←1			;temporary AC
SORPTR←2		;pointer into list of keywords (SORDID)
TXTPTR←3		;pointer into block for storage of characters of keywords
B←←4			;temporary AC
CNT←4			;counter
CHAR←6			;current tty input character
C←7			;temporary AC
DICTWD←10		;pointer to current DICT entry
PART1←11		;first 5 chars of keyword
PART2←12		;next 5 chars of keyword
PART3←13		;next 5 chars of keyword
PART4←14		;next 5 chars of keyword
X←←11			;pointer into the INDEX file
DISPL←←12		;displacement of current story in NEWS from record boundary
SIZE←←14		;size of the current news story
LIST1←←11		;first operand (list of stories) in a set operation
LIST2←←12		;second operand (list of stories) in a set operation
LIST3←←13		;resultant list of stories in a set operation
X1←←14			;index of current story in first list
X2←←15			;index of current story in second list
STYPTR←←16
FIRST←16		;pointer to first part of keyword in WORDS (points to prev word)
P←17			;push down list pointer

LF←←12
CR←←15
ALT←175
TAB←←11

SPECS←←4		;the next 7 lines must be duplicated in most AP programs
XSIZE←←3
MAXNBR←←=500
XLEN←MAXNBR*XSIZE+SPECS
WLEN←←6400
LLEN←←10000
DLEN←←6000		;last line that must be duplicated

SLSTLN←←=750		;length of the story list array (STYLST)
SLEN←←2*=64		;length of the SORDID array
PDLEN←←=100		;length of the pdl
STLEN←←2200		;length of the block for holding stories in core
MAXXPR←←=200		;maximum number of chars in keyword expression
;More definitions.

;the next several lines define the positions of flags in the left half of the
;	accumulator FLAGS.  the first three of these tell where to send the
;	stories that correspond to the keywords typed in.
TYPE←←1		; 1 if the stories should be typed out
SPOOL←←2	; 1 if output file should be spooled
SAVFIL←←4	; 1 if the output file should be saved
OP1FLG←←10	;bits indicating what kind of lists the operands are in a set
OP2FLG←←20	;  operation.  1 means ptr into STYLST, 0 means ptr into LINKS.
MINUS1←←40	; 1 if the 1st story number was preceeded by a minus sign
MINUS2←←100	; 1 if the 2nd story number was preceeded by a minus sign
PAIR←←200	; 1 if two story selection numbers were typed in
ORDER←←400	; 1 if the stories are to come out in reversed order
CHANCE←←1000	; 1 if the user wants a chance to spool, etc., the stories
FEW←←2000	; 1 if the user wants only the first few lines of each story
GOD←←4000	; 1 if the user is AP,SYS
JMC←←10000	; 1 if the user is *,JMC
PPNDUN←←20000	; 1 if the user's ppn has been written in the file USERS
LSTFEW←←40000	; 1 if the user wants only the last few lines of each story

EXTERN	SPOOLM,JOBREN,JOBAPR

DEFINE	ERRMSG(MSG)
	{PUSHJ	P,[	MOVEM	A,SAVEDA
			MOVEI	A,[ASCIZ \MSG\]
			JRST	ERROR]}

DEFINE	FINDLF(LABEL)
	{LABEL:	INCHWL	CHAR
		CAIE	CHAR,LF
		JRST	LABEL}

DEFINE	USRERR(LBL,MSG)
	{JRST	[OUTSTR	[ASCIZ \*** MSG ***\]
		 CLRBFI
		 JRST	LBL]}

COMMENT ⊗  I/O CHANNELS USED

0:DICT
1:LINKS
2:INDEX
3:WORDS
4:NEWS
5:output file for news
14:USERS
15:USE.DAT (input)
16:USE.DAT (output)
17:APMESS (message file)

end of comment ⊗
;Storage allocations for statistics keeping.

DEFINE NAMES <

	XXX	UUNREC,UNRECOGNIZED KEYWORDS............
	XXX	UFIL ,STORIES SAVED IN FILES...........
	XXX	USPL ,STORIES SPOOLED..................
	XXX	UFEW ,ONLY FIRST FEW LINES TYPED OUT...
	XXX	UTYP ,STORIES TYPED OUT................
	XXX	UEXPR,NON-NULL EXPRESSIONS TYPED IN....
	XXX	URAPE,TIMES "R APE" TYPED..............

>

DEFINE XXX(A,B) <
A:	0
>

LOCDAT:	0		;word for xwd time,date in USE.DAT
	NAMES
	0		;extra word because of dump mode bug (losing 4 bits)
ULEN←.-LOCDAT
TOTDAT:	BLOCK	ULEN

DEFINE XXX(A,B) <
	[ASCIZ \B\]
>

MSGDAT:	0
	NAMES		;block of ptrs to ASCIZ strings for data in USE.DAT

USEF:	SIXBIT	/USE/
	SIXBIT	/DAT/
	BLOCK	2
UCMD:	IOWD	ULEN,TOTDAT
	0

MONTHS:	FOR MON IN (Jan,Feb,Mar,Apr,May,June,July,Aug,Sept,Oct,Nov,Dec)
<	[ASCIZ \-MON-\]
>

;USERS file contains a list of programmer names of people who have used APE
USERSF:	SIXBIT	/USERS/
	BLOCK	3
PCMD:	IOWD	1,USERS
	0
;USERS:			;the USERS block is common with the STORY block
USRPPN:	0
;Storage allocations.
NEWSF:	SIXBIT	/NEWS/
	BLOCK	3
INDEXF:	SIXBIT	/INDEX/
	BLOCK	3
LINKSF:	SIXBIT	/LINKS/
	BLOCK	3
DICTF:	SIXBIT	/DICT/
	BLOCK	3
WORDSF:	SIXBIT	/WORDS/
	BLOCK	3
MESSF:	SIXBIT	/APMESS/
	BLOCK	3
FILE:	0		;ENTER block for file to which some news stories are
	SIXBIT	/AP/	;	to be outputted.  Always given the extension .AP
	BLOCK	2
USERS:			;USERS and STORY blocks are the same (common) to save space
STORY:	BLOCK	STLEN	;block for holding text of a story in core
INDEX:	BLOCK	XLEN	;block for holding entire INDEX file
LINKS:	BLOCK	LLEN	;block for holding entire LINKS file
DICT:	BLOCK	DLEN	;block for holding entire DICT file
WORDS:	BLOCK	WLEN	;block for holding entire WORDS file
SORDID:	BLOCK	SLEN	;block of headers for story lists
PDLIST:	BLOCK	PDLEN	;area for push down list
STYLST:	BLOCK	SLSTLN	;block for pointers to the stories found
KEXPR:	BLOCK	MAXXPR/5;block for text of keyword expression
MBUF:	BLOCK	3	;header for buffer for message file
DIGITS:	BLOCK	4

CMD:	IOWD	1,STORY
	0
XCMD:	IOWD	XLEN,INDEX
	0
LCMD:	IOWD	LLEN,LINKS
	0
DCMD:	IOWD	DLEN,DICT
	0
WCMD:	IOWD	WLEN,WORDS
	0
FCMD:	IOWD	1,STORY		;dump mode command for writing out selected stories
	0			;	on a file
SCMD:	IOWD	=14,STARS	;dump mode command for writing out a row of stars
	0			;	in the file containing selected stories
DSK17:	17			;OPEN block for initing the dsk in mode 17
	SIXBIT	/DSK/
	0
TOTAL:	0			;count of the total number of stories found
FLBPTR:	0			;byte ptr for storing sixbit filename in FILE
PPN:	SIXBIT	/ APSYS/	;ppn for all the AP system files
AVSLST:	0			;ptr to first element in list of available STYLST slots
HEAD1:	0			;ptr to first element in first story list in set operation
HEAD2:	0			;ptr to first element in second story list in set operation
SAVEDA:	0			;word for saving AC A upon detection of an error
NFOUND:	0			;total number of stories found in current story list
FSTNBR:	0			;relative number of selected beginning story
SCDNBR:	0			;relative number of selected ending story
HEADER:	0			;header for the sublist of stories selected
SAVNBR:	0			;place for saving in ASCII the nbr of stories found
NBRGON:	0			;place for counting nbr of stories that have disappeared
INTABL:	0			;flag indicating if [ESC] I should have an effect
KXB:	0			;byte ptr into keyword expression being parsed
KSTART:	0			;byte ptr to start of current keyword in keyword expr
CCR:	CR
CRLF:	ASCIZ	/
/]
RAPED:	-1			;counter of number of times user started APE
SEQBEG:	0			;starting sequence number of group
SEQEND:	0			;ending sequence number of group
;Beginning of main program (APE): read in the AP system files.
APE:	MOVE	P,[SETPDL: IOWD PDLEN,PDLIST]
	CALLI	0		;RESET everything
	MOVEI	FLAGS,"@"	;clear all flags and put "@" byte into AC
MAXT←←=45
	MOVEI	B,MAXT		;max length of time we try to lookup DICT
OPNDCT:	OPEN	0,DSK17		;DICT file
	ERRMSG	{OPEN FAILED ON DSK (2)}
	MOVE	A,PPN
	MOVEM	A,DICTF+3
	LOOKUP	0,DICTF
	JRST	[RELEAS	0,
		 CAIL	B,MAXT
		 OUTSTR	[ASCIZ /One moment please.../]
		 SOJL	B,[ERRMSG {Sorry--something seems to be wrong.}]
				;could not LOOKUP DICT for MAXT secs
		 MOVEI	A,1
		 CALL	A,[SIXBIT /SLEEP/]
		 JRST	OPNDCT]
	HLRE	A,DICTF+3	;get size of DICT
	CAMGE	A,[-DLEN]
	ERRMSG	{Horrendous error number 5.  Please report me to ME. (5)}
	HRLM	A,DCMD		;put size into dump mode command for DICT
	IN	0,DCMD
	JRST	.+2
	ERRMSG	{IN UUO FAILED DURING ATTEMPT TO READ IN FILE: DICT (6)}

	OPEN	1,DSK17		;LINKS file
	ERRMSG	{OPEN FAILED ON DSK (8)}
	MOVE	A,PPN
	MOVEM	A,LINKSF+3
	LOOKUP	1,LINKSF
	ERRMSG	{LOOKUP FAILED ON FILE: LINKS (10)}
	IN	1,LCMD
	JRST	.+2
	ERRMSG	{IN UUO FAILED DURING ATTEMPT TO READ IN FILE: LINKS (12)}
	RELEAS	1,
	OPEN	2,DSK17		;INDEX file
	ERRMSG	{OPEN FAILED ON DSK (14)}
	MOVE	A,PPN
	MOVEM	A,INDEXF+3
	LOOKUP	2,INDEXF
	ERRMSG	{LOOKUP FAILED ON FILE: INDEX (16)}
	IN	2,XCMD
	JRST	.+2
	ERRMSG	{IN UUO FAILED DURING ATTEMPT TO READ IN FILE: INDEX (18)}
	RELEAS	2,
	OPEN	3,DSK17		;WORDS file
	ERRMSG	{OPEN FAILED ON DSK (20)}
	MOVE	A,PPN
	MOVEM	A,WORDSF+3
	LOOKUP	3,WORDSF
	ERRMSG	{LOOKUP FAILED ON FILE: WORDS (22)}
	IN	3,WCMD
	JRST	.+2
	ERRMSG	{IN UUO FAILED DURING ATTEMPT TO READ IN FILE: WORDS (24)}
	RELEAS	3,
	RELEAS	0,		;keep the DICT file open until all files have been read in

	INIT	17,0	;KLUDGE TO TYPE OUT THE FILE APMESS
	SIXBIT	/DSK/	;THIS SHOULD BE CLEANED UP SOMETIME SOON!
	MBUF
	ERRMSG	{CANT INIT THE DSK! (24.5)}
	MOVE	A,PPN
	MOVEM	A,MESSF+3
	LOOKUP	17,MESSF	;is there a message file to be typed out?
	JRST	NOMESS		;no
	OUTSTR	CRLF
MORMES:	IN	17,		;yes.  type out one buffer-worth
	JRST	[MOVE	A,MBUF
		 ADDI	A,2	;make A point at first data word in buffer
		 MOVE	B,177(A)
		 SETZB	B+1,177(A)
		 OUTSTR	(A)
		 OUTSTR	B
		 JRST	MORMES]
	OUTSTR	CRLF
NOMESS:	RELEAS	17,

	MOVEI	A,INTRPT
	MOVEM	A,JOBAPR	;set up address of interrupt module
	SETZM	INTABL		;clear interrupt-able flag
	HRLZI	A,4		;enable for interrupts on [ESC] I
	CALLI	A,400025	;INTENB
	MOVEI	A,[RELEAS 4,	;let go of NEWS file upon reentry
		   SETZM  INTABL
		   JRST   RSTART]
	MOVEM	A,JOBREN	;set up reentry address
IFG ULEN <
	PUSHJ	P,CLEARU	;clear local data for USE.DAT
	AOSN	RAPED		;add one to count of number of restarts
	AOS	URAPE		;bump "r ape" count first time only
>
	SETZ	A,
	CALLI	A,24		;GETPPN
	MOVEM	A,USRPPN
	CAMN	A,PPN
	JRST	MAKGOD
	TLZ	A,-1		;zero out project
	CAIN	A,'JMC'
	TLO	FLAGS,JMC
	CAIE	A,' ME'
	JRST	NOSPEC
	SETZ	A,
	CALLI	A,400071	;DSKPPN--get alias ppn
	CAMN	A,PPN
MAKGOD:	TLOA	FLAGS,GOD
NOSPEC:	PUSHJ	P,SAVPPN
;Start of main loop: asking for keywords.  (RSTART,RESET,APE1)
	OUTSTR	[ASCIZ /
Type "?" and RETURN at any time for help.
/]
;								    $
RESET:	MOVE	A,[XWD -SLSTLN+2,STYLST];clear the current story list and
	HRRZM	A,AVSLST		;	return all words of STYLST array
	ADDI	A,1			;	to the available space list
	HRRZM	A,-1(A)
	AOBJN	A,.-1
	SETZM	-1(A)			;put null ptr at end of available list
	SETZM	SORDID+1		;clear ptr to current story list
	SETZM	HEADER			;clear header to current story sublist
RSTART:
;	SETZM	INTABL			;disable interrupts on [ESC] I
	MOVE	P,SETPDL		;reset the pdl pointer (eg, after errors)
APE1:	INSKIP				;reset any printout stop (↑O)
	JFCL
	OUTSTR	[ASCIZ /

KEYWORD EXPRESSION: /]			;ask for keywords expression
	TLNN	FLAGS,GOD+PPNDUN
	PUSHJ	P,SAVPPN		;put PPN in USERS file if haven't yet
IFG ULEN <	PUSHJ	P,PUTDAT
>
	SETZ	SORPTR,			;point to header of current story list
	TLZ	FLAGS,TYPE+SPOOL+SAVFIL	;zero these flags

	MOVEI	CNT,MAXXPR
	MOVE	A,[POINT 7,KEXPR]
	MOVEM	A,KXB
INC:	INCHWL	CHAR
	CAIN	CHAR,LF
	JRST	[OUTCHR	[CR]
		 OUTCHR	[":"]
		 MOVEI	CHAR," "
		 JRST	.+1]
	IDPB	CHAR,A
	CAIN	CHAR,CR
	JRST	APE4
	CAIN	CHAR,ALT
	JRST	APE5
	SOJGE	CNT,INC
	OUTSTR	[ASCIZ /
*** KEYWORD EXPRESSION TOO LONG ***/]
	CLRBFI
	JRST	APE1

APE4:	INCHWL	CHAR			;read the LF that followed the CR
APE5:	

	PUSHJ	P,GETCH			;get first tty character into CHAR
;								    $
	CAIN	CHAR,"?"		;see if request for help
	JRST	[OUTSTR	[ASCIZ $
	Each keyword represents all the stories it occurs in.
There are, in addition to normal English keywords, two special
forms that can be used as keywords in expressions.  The first
consists of a period (.) followed by an unsigned integer, eg, ".18";
if k is the integer following the period, this form represents
a collection of the newest k stories.  The second special form
consists of a number sign (#) followed by an unsigned integer;
this form represents all the stories that have the given integer
as their AP sequence number.
	A keyword expression consists of either a single keyword
or an expression of keywords connected by any of the operators
+ (for UNION), - (for SET DIFFERENCE), and * (for INTERSECTION).
These operators have their usual precedences (* evaluated first).
Note that + and - are BINARY operators only.  Parentheses can be
used freely in keyword expressions.
	For a list of the keywords, TYPE the file WORDS.SRT[AP,SYS]
or SPOOL the file WORDS.LST[AP,SYS].  To get your own special
special keywords added to the list, send a note to ME.
	For more information, read the file APE.ME[UP,DOC].$]
		 JRST APE1]
;Process keyword expression.

	CAIN	CHAR,CR			;is keyword expression null?
	JRST	APE2			;yes. use current story list
	CAIN	CHAR,ALT		;does he want the same sublist as last time?
	JRST	[OUTSTR CRLF
		 SKIPN	LIST3,HEADER	;get ptr to first element of sublist
		 JRST	NONE		;is the sublist null?
		 JRST	DIR0]		;no.
	CAIN	CHAR,"+"		;does expression start with "+"?
	JRST	[PUSHJ	P,PLUS		;yes. perform union with current story list
		 JRST	CHECK]
	CAIN	CHAR,"-"		;does expression start with "-"?
	JRST	[PUSHJ	P,MINUS		;yes. perform set difference from current story list
		 JRST	CHECK]
	CAIN	CHAR,"*"		;does expression start with "*"?
	JRST	[PUSHJ	P,INTER		;yes. perform intersection with current story list
		 PUSHJ	P,TERM2
		 JRST	CHECK]
	PUSHJ	P,TERM			;read in a TERM of keywords
CHECK:	CAIE	CHAR,CR			;the TERM should be followed immediately by a CR.
	JRST	[OUTSTR	[ASCIZ /*** SYNTAX ERROR ***/];	There were some extraneous
		 CLRBFI			;		characters after the TERM.
		 JRST	RSTART]
IFG ULEN <AOS	UEXPR
>
	HRRE	LIST1,SORDID+1(SORPTR)	;get ptr to first element in final story list
	JUMPGE	LIST1,APE2		;is story list a list in LINKS?
	MOVN	LIST1,LIST1		;yes.  copy it into STYLST
	HRRZ	X1,LINKS+1(LIST1)	;	get index ptr to first story
	MOVEI	LIST3,SORDID+1(SORPTR)	;	set up in LIST3 a ptr to prev list element
	TLZ	FLAGS,OP1FLG		;	indicate operand 1 is a list in LINKS
	SETZM	HEAD1			;	indicate no lists to be returned to
	SETZM	HEAD2			;		available STYLST storage
	PUSHJ	P,COPY1			;	actually copy the list into STYLST
APE2:
	JUMPE	SORPTR,APE8		;is old current story list being used?
	SKIPN	A,SORDID+1		;no.  return it to free storage
	JRST	APE8			;if the list is null, nothing to return
	MOVE	B,A			;save ptr to current element
	HRRZ	A,(B)			;get ptr to next element of list
	JUMPN	A,.-2			;have we found the end of the list?
	HRRZ	A,AVSLST		;yes. get ptr to 1st element of old avail list
	HRRZM	A,(B)			;  and store it in last element of returned list
	HRRZ	A,SORDID+1		;get ptr to first element of returned list
	HRRZM	A,AVSLST		;  and store it in header of avail list
APE8:	HRRZ	LIST3,SORDID+1(SORPTR)	;get ptr to first element in story list
	HRRZM	LIST3,SORDID+1		;store it in header to current story list
	SETZ	CNT,			;initialize the count of stories to zero
	JUMPE	LIST3,NOMORE		;check for null list
APE3:	ADDI	CNT,1			;add 1 to count of stories
	HRRZ	LIST3,(LIST3)		;get ptr to next element in story list
	JUMPN	LIST3,APE3		;check if at end of list
	MOVEM	CNT,NFOUND		;save the number of stories found
;Tell user how many stories were found and ask him which ones he wants to select.

NOMORE:	JUMPE	CNT,NONE		;check if number of stories is zero
	MOVE	PART1,CNT		;convert cnt to ascii decimal
	MOVE	B,[POINT 7,DIGITS]
	SETZM	DIGITS
	PUSHJ	P,NXTDG
	MOVE	A,DIGITS
	MOVEM	A,SAVNBR		;save ascii of cnt in case of error
ASK:
	OUTSTR	SAVNBR			;type out the number
	OUTSTR	[ASCIZ / news item(s) found.  Read which one(s)? /]
	TLZ	FLAGS,ORDER+MINUS1+MINUS2+PAIR+CHANCE+FEW+LSTFEW;clear these flags
	MOVEI	A,1
	MOVEM	A,FSTNBR	;initialize beginning story to newest story
	MOVE	A,NFOUND
	MOVEM	A,SCDNBR	;initialize ending story to oldest story
	PUSHJ	P,GETCHR
	OUTCHR	CCR		;output a CR in case line ended with LF
WHICH0:	CAIN	CHAR,CR
	JRST	[INCHWL	CHAR	;read the LF that follows the CR
		 JRST	BUILD]	;wants all the stories typed out
	CAIN	CHAR,LF
	JRST	[TLO	FLAGS,CHANCE	;wants a chance to spool, etc., the stories
		 JRST	BUILD]
	CAIE	CHAR,"F"	;does he want only the first few lines
	CAIN	CHAR,"f"	;	of each story?
	JRST	[TLO	FLAGS,FEW	;yes.  set corresponding flag
		 PUSHJ	P,GETCHR
		 JRST	WHICH0]
	CAIE	CHAR,"L"	;does he want only the last few lines
	CAIN	CHAR,"l"	;	of each story?
	JRST	[TLO	FLAGS,LSTFEW	;yes.  set corresponding flag
		 PUSHJ	P,GETCHR
		 JRST	WHICH0]
	CAIE	CHAR,"N"
	CAIN	CHAR,"n"
	JRST	[FINDLF(LF2)	;doesn't want to see any of the stories
		 JRST	APE1]
	CAIN	CHAR,"?"
	JRST	[CLRBFI		;wants some explanatory help
		 OUTSTR	[ASCIZ $

To select all the stories in normal order (newest story first),
   type nothing (blank line).
To select None of the stories, type "N" (for None).
To select the k newest stories in normal order, type the number "k".
To select the k oldest stories in normal order, type the number "-k".
To select the jth story thru the kth story, type "j:k".  Note that
   in this construction, "1" represents the newest story, larger
   numbers represent older stories, "*" represents the oldest story,
   and finally, "-k" represents the kth oldest story.  Thus, "-1" is
   equivalent to "*"; both represent the oldest story.  The stories
   will come out in the order you specify: story j first, story k
   last.
To have only the first few lines of each story you select typed out,
   type an "F" (for Fast) at the beginning of the line.
To reverse the order in which the stories come out, type "=" at the
   beginning of the line.  (The "=" may come before or after "F".)
THE SELECTION LINE YOU TYPE SHOULD END WITH EITHER A CARRIAGE RETURN
   OR A LINEFEED.  CARRIAGE RETURN will cause the selected stories
   just to be typed out.  LINEFEED will give you the chance to
   save the stories in a file and/or spool them, in addition to
   possibly having them typed out.

$]
		 JRST	ASK]
;Read in story selection numbers and build up sublist of selected stories.
WHICH2:	CAIE	CHAR,"="	;does he want the order of the stories reversed?
	JRST	WHICH1		;no
	TLC	FLAGS,ORDER	;yes.  complement the order flag
	PUSHJ	P,GETCHR
	JRST	WHICH0
WHICH1:	CAIE	CHAR,"-"
	JRST	WHICH3
	TLO	FLAGS,MINUS1	;set flag to indicate that 1st story nbr was negative
	PUSHJ	P,GETCHR
WHICH3:	PUSHJ	P,GETSTY
	JUMPE	CNT,[WHICH4:	OUTSTR	[ASCIZ /*** MISSING OR ZERO STORY NUMBER.  /]
		     WHICH5:	CLRBFI
				OUTSTR	[ASCIZ /TRY AGAIN. ***

/]
				JRST	ASK]
	CAMLE	CNT,NFOUND	;has a nonexistent story been selected?
	JRST	[NONEXS: OUTSTR [ASCIZ /*** STORY NUMBER TOO BIG.  /]
			 JRST	WHICH5]
	MOVEM	CNT,FSTNBR
	CAIE	CHAR,":"
	JRST	WHICH6
	TLO	FLAGS,PAIR	;set flag to indicate that a pair of nbrs were typed in
	PUSHJ	P,GETCHR
	CAIE	CHAR,"-"
	JRST	WHICH7
	TLO	FLAGS,MINUS2	;set flag to indicate that 2nd story nbr was negative
	PUSHJ	P,GETCHR
WHICH7:	PUSHJ	P,GETSTY
	JUMPE	CNT,WHICH4
	CAMLE	CNT,NFOUND
	JRST	NONEXS
	MOVEM	CNT,SCDNBR
WHICH6:	CAIN	CHAR,CR		;does he want the chance to spool, etc.?
	JRST	WHICH9		;nope
	CAIE	CHAR,LF		;maybe
	JRST	[OUTSTR	[ASCIZ /*** ???  /]
		 JRST	WHICH5]
	TLOA	FLAGS,CHANCE	;yup. set flag giving a chance to do so?
WHICH9:	INCHWL	CHAR		;read the lf following the cr
;Build up a list of the stories selected.
CLUNK:	TLNE	FLAGS,PAIR	;were a pair of story numbers typed in?
	JRST	HAVEPR		;yes
	TLNE	FLAGS,MINUS1	;no. did the story number have a minus sign?
	JRST	GETOLD		;yes
	MOVE	A,FSTNBR	;no. select the most recent FSTNBR stories
	MOVEM	A,SCDNBR	;end with story number FSTNBR
	MOVEI	A,1
	MOVEM	A,FSTNBR	;start with story number 1
	JRST	BUILD
GETOLD:	MOVE	A,NFOUND
	MOVEM	A,SCDNBR	;end with last story
	SUB	A,FSTNBR	;calculate the number of the FSTNBR oldest story
	ADDI	A,1
	MOVEM	A,FSTNBR	;store number of starting story
	JRST	BUILD
;Continue building up a list of the stories selected.

HAVEPR:	TLNN	FLAGS,MINUS1	;did the first story number have a minus sign?
	JRST	CHK2ND		;no.  see if the 2nd story did.
	MOVE	A,NFOUND	;yes
	SUB	A,FSTNBR	;calculate the number of the FSTNBR oldest story
	ADDI	A,1
	MOVEM	A,FSTNBR	;store number of starting story
CHK2ND:	TLNN	FLAGS,MINUS2	;did the second story number have a minus sign?
	JRST	BUILD		;no
	MOVE	A,NFOUND	;yes
	SUB	A,SCDNBR	;calculate the number of the SCDNBR oldest story
	ADDI	A,1
	MOVEM	A,SCDNBR	;store number of ending story

BUILD:	SKIPN	C,HEADER	;is there a non-null sublist sitting around?
	JRST	GRONK		;no
	SETZM	HEADER		;yes. return the sublist to the avail list
	SKIPA	B,C
	MOVE	B,A		;save ptr to current element of list
	HRRZ	A,(B)		;get ptr to next element
	JUMPN	A,.-2		;have we found the end of the list?
	HRRZ	A,AVSLST	;yes.  get ptr to 1st element of old avail list
	HRRZM	A,(B)		;  and store it in last element of returned list
	HRRZM	C,AVSLST	;save ptr to 1st element of new avail list
GRONK:	MOVE	A,FSTNBR	;load numbers of beginning and ending stories and
	MOVE	B,SCDNBR	;	build up sublist of those stories
	CAMG	A,B		;are oldest stories to come first?
	JRST	BUILD1		;no
	EXCH	A,B		;put number of lowest numbered story into A
	TLC	FLAGS,ORDER	;set flag indicating the list built up should be in rev order
BUILD1:	SUBI	B,-1(A)		;put number of stories to be collected into B
	HRRZ	LIST1,SORDID+1(SORPTR);get ptr to first element of whole list
BUILD2:	MOVE	LIST1,(LIST1)	;get the next element of the whole list
	SOJG	A,BUILD2	;have we reached the first story for the sublist?
	TLNE	FLAGS,ORDER	;yes. should the stories be collected in reverse order?
	JRST	BLDREV		;yes
	MOVEI	LIST3,HEADER	;get ptr to the header for the sublist
BUILD3:	PUSHJ	P,GETAVL	;put this story into the sublist
	HLLM	LIST1,(LIST3)	;put the index of this story into the sublist element
	MOVE	LIST1,(LIST1)	;get the next element of the whole list
	SOJG	B,BUILD3	;have we collected the necessary number of stories?
	HLLZS	(LIST3)		;yes.  put null ptr at end of sublist
	HRRZ	LIST3,HEADER	;load LIST3 with ptr to first element of sublist
	JRST	DOESHE
BLDREV:	SETZ	LIST3,		;make ptr to current sublist element null
REV3:	SKIPN	STYPTR,AVSLST	;get available word for reversed story list
	JRST	NUNAVL		;there are no available words for the story list!
	MOVE	A,(STYPTR)	;get ptr to 2nd available word and store it
	MOVEM	A,AVSLST	;	in header of available list
	HRRZM	LIST3,(STYPTR)	;put ptr to prev list element in new list element
	MOVE	LIST3,STYPTR	;put ptr to new element into LIST3
	HLLM	LIST1,(LIST3)	;put the index of this story into the sublist element
	MOVE	LIST1,(LIST1)	;get the next element of the whole list
	SOJG	B,REV3		;have we collected the necessary number of stories?
	HRRZM	LIST3,HEADER	;store ptr to the sublist for returning it to avail storage
DOESHE:	TLNN	FLAGS,CHANCE	;does he want a chance to spool, etc., the stories?
	JRST	TYPEM1		;no
	TLNE	FLAGS,FEW	;does he want only the first few lines of each story?
	JRST	TYPEM1		;yes.  not allowed to spool, etc.
;Find out where the news should be directed: tty, spooler, and/or a file.

DIR0:	OUTSTR	[ASCIZ $Direct the news where? (Tty, Spooler, and/or File) $]
	INCHWL	A		;read in response and see where news is to be sent
	CAIE	A,"?"		;does the user want some help?
	JRST	BOT		;no
	CLRBFI			;yes
	OUTSTR	[ASCIZ $
To have the news typed out, spooled, AND/OR saved in a file, type
any combination of the letters T, S, and F, which represent
respectively your Teletype, the Spooler, and a File.  End your
response with a carriage return.

$]
	JRST	DIR0
DIR1:	TRZ	A,40
	CAIN	A,"T"
	TLO	FLAGS,TYPE	;he wants the news typed out
	CAIN	A,"S"
	TLO	FLAGS,SPOOL	;he wants the news spooled
	CAIN	A,"F"
	TLO	FLAGS,SAVFIL	;he wants the news saved in a file
	INCHWL	A
BOT:	CAIE	A,LF
	JRST	DIR1
DIR2:	TLNN	FLAGS,SAVFIL	;does he want the news saved in a file?
	JRST	DIR4		;no.

;read in file name, convert it to sixbit and store it in an ENTER block at FILE
DIR7:	OUTSTR	[ASCIZ /Type filename (the extension .AP will be used): /];
	MOVE	A,[POINT 6,FILE];set up byte ptr for depositing chars of file name
	MOVEI	CNT,6		;limit file name to first 6 characters
	SETZM	FILE		;zero out any old file name left around
DIR3:	INCHWL	CHAR		;read in file name chars until CR or "." or 6 chars
	CAIN	CHAR,CR
	JRST	DIR12		;found CR
	CAIN	CHAR,"."	;don't allow file names to contain "."
	JRST	[NOEXT: CLRBFI
		 OUTSTR	[ASCIZ /
Do not specify an extension for the file.
/]
		 JRST	DIR7]
	TRZ	CHAR,40		;convert to sixbit: replace old 40 bit with old 100 bit
	TRZE	CHAR,100
	TRO	CHAR,40
	IDPB	CHAR,A		;store the sixbit char in the file name
	SOJG	CNT,DIR3	;if haven't found 6 chars yet, go back and get more
DIR12:	INCHWL	CHAR		;read until LF
	CAIN	CHAR,"."
	JRST	NOEXT		;if he typed an extension, demand another filename
	CAIE	CHAR,LF
	JRST	DIR12
;LOOKUP output file to see if it already exists.  Then ENTER output file.

DIR5:	OPEN	5,DSK17		;see if file specified already exists.
	ERRMSG	{OPEN FAILED ON DSK (26)}
	SETZM	FILE+3		;file will be on the users area
	LOOKUP	5,FILE
	JRST	DIR6		;file doesn't exist.  go do an ENTER on it
	RELEAS	5,
	OUTSTR	[ASCIZ /
FILE ALREADY EXISTS! 
/]
	JRST	DIR7		;file already exists.  ask for another file name

;Enter file for saving/spooling stories.
DIR6:	RELEAS	5,
	OPEN	5,DSK17		;do an ENTER on the output file for the news
	ERRMSG	{OPEN FAILED ON DSK (28)}
	HLLZS	FILE+1		;file gets standard extension .AP
	SETZM	FILE+2
	SETZM	FILE+3		;put file on user's disk area
	ENTER	5,FILE
	JRST	.+2		;ENTER failed
	JRST	TYPEM		;ENTER succeeded
	RELEAS	5,
	TLNN	FLAGS,SAVFIL	;was the ENTER for a file only to be spooled?
	AOJA	A,DIR9		;yes. increment the name of the special spooling file
	OUTSTR	[ASCIZ /
ENTER failed.
/]				;no. tell user that the ENTER failed on the file name he gave
	JRST	DIR7		;go ask for another file name
DIR4:	TLNN	FLAGS,SPOOL+TYPE;doesn't want news saved in a file.
	JRST	APE1		;he doesn't want to see the news at all
	TLNN	FLAGS,SPOOL	;does he want the news spooled?
	JRST	TYPEM		;he wants the news typed out only
	MOVE	A,[SIXBIT /$NEWS0/];initialize name for the special file for spooling
DIR9:	MOVEM	A,FILE		;put file name in LOOKUP/ENTER block
	OPEN	5,DSK17
	ERRMSG	{OPEN FAILED ON DSK (30)}
	SETZM	FILE+3		;put spooling file on users disk area
	LOOKUP	5,FILE		;does file already exist?
	JRST	DIR6		;no.  go do an ENTER on it
	RELEAS	5,		;yes.  increment special name and try again
	AOJA	A,DIR9
;Read in the stories found: TYPEM1, TYPEM.

TYPEM1:	TLO	FLAGS,TYPE	;set flag to have the stories typed out
TYPEM:	SETOM	INTABL		;set flag to allow interrupt on [ESC] I
	TLNE	FLAGS,TYPE	;type out rows of stars before first story
	OUTSTR	[ASCIZ /

************************************************************


/]
	SETZM	NBRGON			;zero out the counter of stories gone
NXTSTY:	HLRZ	X,(LIST3)		;get index of current story in story list
EXTRA:	HRRZ	DISPL,INDEX+1(X)	;get the story's displ from beginning of rec
	MOVE	SIZE,X			;calculate the index of the next story
	ADDI	SIZE,XSIZE
	CAIL	SIZE,XLEN
	MOVEI	SIZE,SPECS
	MOVN	SIZE,INDEX+1(SIZE)	;subtract the rec nbr and displ of next story from zero
	ADD	SIZE,INDEX+1(X)		;	and add in the rec nbr and displ of the
	JUMPL	SIZE,ONWARD		;	current story. this gets negated size of current story
DOWN:	MOVN	SIZE,INDEX+3		;the current story is the bottom one in NEWS
	JUMPE	SIZE,GONE		;zero means this is a fake story. NEWS has never wrapped around
	ADD	SIZE,INDEX+1(X)		;recalculate its size using ptr to bottom of file
ONWARD:	ASH	SIZE,-13		;shift out the =11 low order zero bits of the size
	ASH	DISPL,-13		;shift out the =11 low order zero bits of the displ
	HRLZM	SIZE,FCMD		;store the negated size of the story in the output command
	SUB	SIZE,DISPL		;add in the displ to get the amt that has to be read in
	HRLM	SIZE,CMD		;store this amt (negated) in the input command
AGAIN1:	OPEN	4,DSK17			;LOOKUP the NEWS file for reading in the story
	ERRMSG	{OPEN FAILED ON DSK (32)}
	MOVE	A,PPN
	MOVEM	A,NEWSF+3		;store ppn of [ap,sys] in lookup block
	LOOKUP	4,NEWSF
	JRST	[RELEASE 4,		;NEWS file in use. wait and try the LOOKUP again
		 MOVEI	A,1
		 CALL	A,[SIXBIT /SLEEP/]
		 JRST	AGAIN1]
	HLRZ	A,INDEX+1(X)		;get the record nbr for this story
	USETI	4,(A)			;select that record for input from NEWS
	IN	4,CMD			;read in the story in STORY area
	JRST	.+2
	ERRMSG	{IN UUO FAILED DURING ATTEMPT TO READ IN NEWS STORY (34)}
	RELEAS	4,
;Type out and/or file stories.  Then close and/or spool output file, if any.

	ADDI	DISPL,STORY		;make DISPL into ptr to first word of the story
	LDB	B,[POINT 7,(DISPL),6]	;CALCULATE APPARENT SEQ NBR OF STORY READ
	SUBI	B,60			;	IN FROM NEWS
	IMULI	B,=10
	LDB	C,[POINT 7,(DISPL),13]
	ADDI	B,-60(C)
	IMULI	B,=10
	LDB	C,[POINT 7,(DISPL),20]
	ADDI	B,-60(C)
	HRRZ	A,INDEX+2(X)	;GET SEQ NBR FROM INDEX FOR THIS STORY
	CAME	A,B		;CHECK CALCULATED SEQ NBR AGAINST THAT IN INDEX
	JRST	[GONE:	AOS	NBRGON
			JRST	GETNXT]	;the sequence number check failed!
	TLNN	FLAGS,TYPE	;does user want the story typed out?
	JRST	TYP9		;no
	TLNN	FLAGS,FEW	;does he want only first few lines of each story?
	JRST	TYP7		;no
	MOVE	A,[ASCIZ /

/]
	MOVEM	A,=50(DISPL)	;print only first =50 words (=250 chars)
	OUTSTR	(DISPL)		;type out the first few lines
IFG ULEN <AOS	UFEW
>
	JRST	TYP8
TYP7:
	TLNN	FLAGS,LSTFEW	;does he want only the last few lines of each story?
	JRST	TYP6
	MOVEI	A,STORY-=25	;compute ptr to =25 words before end of story
	SUB	A,SIZE
	CAMGE	A,DISPL		;is this ptr in middle of story?
	MOVE	A,DISPL		;no. must be a very short story. type it all out.
	OUTSTR	(A)
	JRST	TYP8

TYP6:	OUTSTR	(DISPL)		;type out the story
IFG ULEN <AOS	UTYP
>
	TLNN	FLAGS,SAVFIL+SPOOL	;is there an output file?
	JRST	TYPE1		;no
TYP9:	SUBI	DISPL,1		;write out this story on the file
	HRRM	DISPL,FCMD	;store in the output command a ptr to word before story's first word
	OUT	5,FCMD		;write out the story on the output file
	JRST	.+2
	ERRMSG	{OUT UUO FAILED DURING ATTEMPT TO WRITE OUT A STORY ON A FILE (36)}
IFG ULEN <TLNE	FLAGS,SAVFIL
	AOS	UFIL
	TLNE	FLAGS,SPOOL
	AOS	USPL
>
TYPE1:	HRRE	X,INDEX(X)	;is this story linked up with a follow-up
	JUMPG	X,EXTRA		;	story of some kind?
	INSKIP			;reset typeout flag in case user typed ↑O
	JFCL
	TLNN	FLAGS,TYPE	;no.  is the news being typed out?
	OUTCHR	["@"]		;no.  type out an "@" for each story writen on the file
	TLNE	FLAGS,TYPE	;if the news is being typed out, separate stories with *'s
TYP8:	OUTSTR	[STARS: ASCIZ /************************************************************


/]
	TLNE	FLAGS,SAVFIL+SPOOL;if the stories are being filed, put a row of asterisks
	OUT	5,SCMD		;	after each story in the file
	JRST	.+2
	ERRMSG	{OUT UUO FAILED DURING ATTEMPT TO WRITE OUT STARS BETWEEN STORIES}
GETNXT:	HRRZ	LIST3,(LIST3)	;get ptr to next element in story list
	JUMPN	LIST3,NXTSTY	;if not at end of list, go back and process next story
	SETZM	INTABL		;disable action on [ESC] I
	SKIPN	PART1,NBRGON
	JRST	DIR8
	MOVE	B,[POINT 7,DIGITS]
	PUSHJ	P,NXTDG
	SETZ	PART1,
	IDPB	PART1,B
	OUTSTR	DIGITS
	OUTSTR	[ASCIZ / OF THE STORIES WENT AWAY--SORRY

/]

;the news stories have now been outputted as requested.
;if there was a file open, close it.  if it should be spooled, do so now.
DIR8:	TLNN	FLAGS,TYPE	;if stories are not being typed, type a CRLF after the "@"'s
	OUTSTR	CRLF
	TLNE	FLAGS,SPOOL+SAVFIL	;is there an output fle?
	RELEAS	5,		;yes.  close it
	TLNN	FLAGS,SPOOL	;is the news to be spooled?
	JRST	APE1		;no
	HLLZS	FILE+1		;yes. zero the spooler flags
	MOVEI	A,1
	TLNN	FLAGS,SAVFIL	;should the file be deleted after spooling?
	HRRM	A,FILE+1	;yes.  set the delete flag for spooler
	PUSHJ	P,SPOOLM	;spool the file
	JUMP	FILE		;ptr to data block for spooler
	JRST	APE1		;go back and get next set of keywords
;Subroutines: TERM, FACTOR, PRIMAR.
TERM:	PUSHJ	P,FACTOR	;term ::=  factor { [+|-] factor }
TERM2:	CAIN	CHAR,"+"	;	where [...] means choose one of ..., and
	JRST	PLUS		;	where {...} means ... may occur zero or more times
	CAIE	CHAR,"-"
	POPJ	P,
MINUS:	PUSHJ	P,SDIFF		;take the set difference of the two factors separated by -
	JRST	TERM2		;look for more +'s or -'s
PLUS:	PUSHJ	P,UNION		;take the union of the two factors separated by +
	JRST	TERM2		;look for more +'s or -'s
FACTOR:	PUSHJ	P,PRIMAR	;factor ::= primary { * factor }
	CAIE	CHAR,"*"	;	note: factors are intersected from right to
	POPJ	P,		;	left since in this case that's equivalent to left to right
	JRST	INTER		;take the intersection of the primary and factor separated by *
PRIMAR:	CAIE	CHAR,"("	;primary ::= keyword | ( term )
	JRST	GETWD		;no "(".  get a keyword.
	PUSHJ	P,GETCH		;found "(".  get next char.
	PUSHJ	P,TERM		;get term following "("
	CAIN	CHAR,")"	;check for ")" after term
	JRST	GETCH		;found ")".  get next char and return from PRIMAR
	OUTSTR	[ASCIZ /*** MISSING RIGHT PARENTHESIS ***/]
	CLRBFI			;didn't find ")"
	JRST	RSTART

;read in a keyword from the tty and look it up in the dictionary
GETWD:	ADDI	SORPTR,2		;make new entry in SORDID for story list for this keyword
	CAIN	CHAR,"."		;does this keyword specify the latest news?
	JRST	LATEST			;yes
	CAIN	CHAR,"#"		;does this "keyword" specify a certain seq nbr?
	JRST	SEQNBR			;yes.  collect all stories with given seq nbr
	MOVE	A,KXB
	MOVEM	A,KSTART		;save byte ptr to current keyword
	PUSHJ	P,READWD
;Search the dictionary for the specified keyword.
CKNULL:	CAMN	PART1,[NULL: ASCII /@@@@@/];is the word null (has no characters)?
	USRERR	RSTART,MISSING KEYWORD
	SETZ	DICTWD,			;initialize ptr to just before 1st word in dictionary

NXTDWD:	ADDI	DICTWD,2		;advance DICTWD ptr to the next word in the dictionary
	HLRZ	FIRST,DICT(DICTWD)	;get ptr to the text of the dictionary word
	MOVE	A,CNT			;move length of typed-in keyword into A
;compare the typed-in keyword with the dictionary word
	CAME	PART1,WORDS(FIRST)	;method of comparison: compare 5 chars at a time
	JRST 	CK1			;	until either the two words differ or
	AOJGE	A,FOUND			;	the end of the typed-in keyword is
	CAME	PART2,WORDS+1(FIRST)	;	reached.  If the two words differ, check
	JRST	CK2			;	which comes first alphabetically.  If the
	AOJGE	A,FOUND			;	dictionary word comes first, go back and
	CAME	PART3,WORDS+2(FIRST)	;	get the next dictionary word.  If the
	JRST	CK3			;	typed-in word comes first, then it
	AOJGE	A,FOUND			;	isn't in the dictionary.
	CAMN	PART4,WORDS+3(FIRST)
	JRST	FOUND
CK4:	CAMG	PART4,WORDS+3(FIRST)
	JRST	NOTFND			;typed-in word not in the dictionary
	JRST	NXTDWD			;get the next dictionary word
CK3:	CAMG	PART3,WORDS+2(FIRST)
	JRST 	NOTFND
	JRST	NXTDWD
CK2:	CAMG	PART2,WORDS+1(FIRST)
	JRST	NOTFND
	JRST	NXTDWD
CK1:	CAMG	PART1,WORDS(FIRST)
	JRST	NOTFND
	JRST	NXTDWD
;Subroutines: FOUND, FINWD, NOMULT.

FOUND:
	PUSHJ	P,GETCH1
	PUSHJ	P,READWD
	CAMN	PART1,NULL
	JRST	FINWD
	HLRZ	DICTWD,DICT+1(DICTWD)

NXBRO:	JUMPE	DICTWD,NOMULT		; 0 means user wants mult key, but there is none
	HLRZ	FIRST,DICT(DICTWD)
	MOVE	A,CNT
	CAME	PART1,WORDS(FIRST)
	JRST	GETBRO
	AOJGE	A,FOUND
	CAME	PART2,WORDS+1(FIRST)
	JRST	GETBRO
	AOJGE	A,FOUND
	CAME	PART3,WORDS+2(FIRST)
	JRST	GETBRO
	AOJGE	A,FOUND
	CAMN	PART4,WORDS+3(FIRST)
	JRST	FOUND
GETBRO:	HRRZ	DICTWD,DICT+2(DICTWD)
	JRST	NXBRO

FINWD:	HRRZ	A,DICT+1(DICTWD)	;get ptr to first LINKS slot for this word
	CAIN	A,-1
	JRST	NOMULT
	MOVN	A,A
	HRRM	A,SORDID+1(SORPTR)	;	and store it negated with this keyword
	JRST	GETCH1			;skip any special chars after keyword (blanks, CR's, LF's, tabs

NOMULT: PUSHJ	P,GETCH1
	PUSHJ	P,READWD
	CAME	PART1,NULL
	JRST	NOMULT
	SETZ	A,
	DPB	A,KXB
	MOVEI	A," "
	HRRZ	B,KSTART
	HRLI	B,350700
	JRST	CKBP
INCBP:	DPB	A,B
	IBP	B
CKBP:	CAME	B,KSTART
	JRST	INCBP
	OUTSTR	[ASCIZ /*** UNRECOGNIZED KEYWORD: /]
	OUTSTR	(B)
	OUTSTR	[ASCIZ / ***/]
	CLRBFI
IFN ULEN <AOS	UUNREC
>
	JRST	RSTART
;Subroutines: READWD.

READWD:	SETZ	PART1,
	SETZ	PART2,
	SETZ	PART3,
	SETZ	PART4,
	MOVEI	CNT,=20			;limit the number of chars in keyword to 20
	MOVE	TXTPTR,[POINT 7,PART1]	;initialize byte ptr to deposit chars in ACs PART1-4
NXTCHR:	CAIL	CHAR,"a"		;is current char a small letter?(less than"a"?)
	CAILE	CHAR,"z"		;maybe. Is it less than than "z"?
	JRST	NOTSML			;not a small letter
	TRZ	CHAR,40			;was a small letter. turn off 40 bit making it a cap letter
	JRST	GOTLTR
NOTSML:	CAIL 	CHAR,"0"		;is this char eligible to be in a keyword?
	CAILE	CHAR,"Z"
	JRST	RWD1			;no.  must be end of keyword
	CAILE	CHAR,"9"		;maybe.  does it come between "9" and "A"?
	CAIL	CHAR,"A"
	JRST	GOTLTR			;no.  must be a letter or a digit
	JRST	RWD1			;yes.  end of keyword
GOTLTR:	SOJL	CNT,.+2			;it is a letter.  has keyword already got 20 chars in it?
	IDPB	CHAR,TXTPTR		;no.  put current char in TEXT
	ILDB	CHAR,KXB		;get the next character
	JRST	NXTCHR
RWD1:	JUMPG	CNT,DEP100
	HRREI	CNT,-4			;put negated number of ACs holding keyword into CNT
	POPJ	P,
DEP100:	IDPB	FLAGS,TXTPTR		;deposit an "@" at end of keyword in PARTs
	SUBI	CNT,1
	TLNE	TXTPTR,760000		;byte ptr now pointing to low order byte in word?
	JRST	DEP100			;no.  go deposit another "@"
	IDIVI	CNT,5			;calculate negated number of ACs holding keyword
	SUBI	CNT,4
	POPJ	P,
;Subroutines: GETCH, GETAVL, NOTFND, NONE, ERROR.
GETCHR:	INCHWL	CHAR		;subroutine to put into CHAR the next tty
GETCR1:	CAIE	CHAR," "	;	character that is not a blank or
	CAIN	CHAR,TAB	;	a tab
	JRST	GETCHR
	POPJ	P,
GETCH:	ILDB	CHAR,KXB	;subroutine to put into CHAR the next tty
GETCH1:	CAIE	CHAR," "	;	character that is not a blank,
	CAIN	CHAR,TAB	;	a tab, or a line feed.
	JRST	GETCH
	POPJ	P,

GETAVL:	MOVE	STYPTR,AVSLST		;get available word for story list
	JUMPE	STYPTR,[NUNAVL: OUTSTR [ASCIZ /

STORY LIST SPACE EXCEEDED--YOU LOSE.  (TEMPORARY LISTS EXCEED 750 STORIES)/]
		 CLRBFI
		 JRST	RESET]
	MOVE	A,(STYPTR)		;get ptr to 2nd available word and store it
	MOVEM	A,AVSLST		;	in header of available list
	HRRM	STYPTR,(LIST3)		;link up last element to this new element
	MOVE	LIST3,STYPTR		;leave ptr to new element in LIST3
	POPJ	P,

NOTFND:	CAMN	PART1,[ASCII /FOO@@/]
	JRST	[FOOBAZ: CLRBFI
		 TLNE	FLAGS,GOD+JMC
		 JRST	[PUSHJ	P,PRINTU
			 JRST	RSTART]
		 OUTSTR	[ASCIZ /WHAT OTHER GOOD KEYWORDS DO YOU HAVE?/]
		 JRST	RSTART]
	CAMN	PART1,[ASCII /BAZ@@/]
	JRST	[CLRBFI
		 TLNE	FLAGS,GOD
		 JRST	[PUSHJ	P,ZEROUS
			 JRST	RSTART]
		 OUTSTR	[ASCIZ /CAN'T YOU THINK OF ANYTHING ORIGINAL?/]
		 JRST	RSTART]
	JRST	NOMULT

NONE:	OUTSTR	[ASCIZ /NO NEWS ITEMS FOUND/]	;keywords had no associated news stories
	JRST	APE1

ERROR:	OUTSTR	[CRLFS: ASCIZ /

/]
	OUTSTR	(A)			;type out error message
	OUTSTR	CRLFS
	MOVE	A,SAVEDA		;restore accumulator A
	CALL	1,[SIXBIT /EXIT/]
	HALT	.
;Subroutines: SETUP, NEXT1, NEXT2.

SETUP:	HRLM	SORPTR,(P)
	PUSHJ	P,GETCH
	PUSHJ	P,FACTOR
	TLZ	FLAGS,OP1FLG+OP2FLG
	HLRZ	A,(P)
	HRRE	LIST1,SORDID+1(A)
	HLLZS	SORDID+1(A)
	HRRE	LIST2,SORDID+1(SORPTR)
	MOVEI	LIST3,SORDID+1(SORPTR)
	JUMPLE	LIST1,SET1
	TLO	FLAGS,OP1FLG
	MOVEM	LIST1,HEAD1
	HLRZ	X1,(LIST1)
	JRST	SET2
SET1:	MOVN	LIST1,LIST1
	HRRZ	X1,LINKS+1(LIST1)
	SETZM	HEAD1
SET2:	JUMPLE	LIST2,SET3
	TLO	FLAGS,OP2FLG
	MOVEM	LIST2,HEAD2
	HLRZ	X2,(LIST2)
	POPJ	P,
SET3:	MOVN	LIST2,LIST2
	HRRZ	X2,LINKS+1(LIST2)
	SETZM	HEAD2
	POPJ	P,

NEXT1:	TLNE	FLAGS,OP1FLG
	JRST	NEXT11
	HLRZ	LIST1,LINKS(LIST1)
	HRRZ	X1,LINKS+1(LIST1)
	POPJ	P,
NEXT11:	HRRZ	LIST1,(LIST1)
	HLRZ	X1,(LIST1)
	POPJ	P,

NEXT2:	TLNE	FLAGS,OP2FLG
	JRST	NEXT21
	HLRZ	LIST2,LINKS(LIST2)
	HRRZ	X2,LINKS+1(LIST2)
	POPJ	P,
NEXT21:	HRRZ	LIST2,(LIST2)
	HLRZ	X2,(LIST2)
	POPJ	P,
;Subroutines: SDIFF.

SDIFF:	PUSHJ	P,SETUP
SD0:	JUMPE	LIST1,FINISH
	JUMPE	LIST2,COPY1
	CAME	X1,X2
	JRST	SD4
	PUSHJ	P,NEXT1
	PUSHJ	P,NEXT2
	JRST	SD0
SD4:	CAML	X1,INDEX+2
	JRST	SDBOTT
	CAMG	X1,X2
	JRST	SD1
SD2:	PUSHJ	P,GETAVL
	HRLM	X1,(LIST3)
	PUSHJ	P,NEXT1
	JRST	SD0
SD1:	CAML	X2,INDEX+2
	JRST	SD2
SD3:	PUSHJ	P,NEXT2
	JRST	SD0
SDBOTT:	CAML	X2,INDEX+2
	CAMG	X1,X2
	JRST	SD3
	JRST	SD2
;Subroutines: UNION.

UNION:	PUSHJ	P,SETUP
UN0:	JUMPE	LIST1,COPY2
	JUMPE	LIST2,COPY1
	CAME	X1,X2
	JRST	UN4
	PUSHJ	P,GETAVL
	HRLM	X1,(LIST3)
	PUSHJ	P,NEXT1
	PUSHJ	P,NEXT2
	JRST	UN0
UN4:	CAML	X1,INDEX+2
	JRST	UNBOTT
	CAMG	X1,X2
	JRST	UN1
UN2:	PUSHJ	P,GETAVL
	HRLM	X1,(LIST3)
	PUSHJ	P,NEXT1
	JRST	UN0
UN1:	CAML	X2,INDEX+2
	JRST	UN2
UN3:	PUSHJ	P,GETAVL
	HRLM	X2,(LIST3)
	PUSHJ	P,NEXT2
	JRST	UN0
UNBOTT:	CAML	X2,INDEX+2
	CAMG	X1,X2
	JRST	UN3
	JRST	UN2
;Subroutines: INTER.

INTER:	PUSHJ	P,SETUP
INT0:	JUMPE	LIST1,FINISH
	JUMPE	LIST2,FINISH
	CAME	X1,X2
	JRST	INT4
	PUSHJ	P,GETAVL
	HRLM	X1,(LIST3)
	PUSHJ	P,NEXT1
	PUSHJ	P,NEXT2
	JRST	INT0
INT4:	CAML	X1,INDEX+2
	JRST	INBOTT
	CAMG	X1,X2
	JRST	INT1
INT2:	PUSHJ	P,NEXT1
	JRST	INT0
INT1:	CAML	X2,INDEX+2
	JRST	INT2
INT3:	PUSHJ	P,NEXT2
	JRST	INT0
INBOTT:	CAML	X2,INDEX+2
	CAMG	X1,X2
	JRST	INT3
	JRST	INT2
;Subroutines: COPY1,COPY2,FINISH.

COPY1:	JUMPE	LIST1,FINISH
	TLNE	FLAGS,OP1FLG
	JRST	COP12
COP11:	PUSHJ	P,GETAVL
	HRLM	X1,(LIST3)
	HLRZ	LIST1,LINKS(LIST1)
	HRRZ	X1,LINKS+1(LIST1)
	JUMPN	LIST1,COP11
	JRST	FINISH
COP12:	PUSHJ	P,GETAVL
	HRLM	X1,(LIST3)
	HRRZ	LIST1,(LIST1)
	HLRZ	X1,(LIST1)
	JUMPN	LIST1,COP12
	JRST	FINISH
COPY2:	JUMPE	LIST2,FINISH
	TLNE	FLAGS,OP2FLG
	JRST	COP22
COP21:	PUSHJ	P,GETAVL
	HRLM	X2,(LIST3)
	HLRZ	LIST2,LINKS(LIST2)
	HRRZ	X2,LINKS+1(LIST2)
	JUMPN	LIST2,COP21
	JRST	FINISH
COP22:	PUSHJ	P,GETAVL
	HRLM	X2,(LIST3)
	HRRZ	LIST2,(LIST2)
	HLRZ	X2,(LIST2)
	JUMPN	LIST2,COP22
FINISH:	HLLZS	(LIST3)
	MOVE	STYPTR,AVSLST
	MOVE	A,HEAD1
	MOVEI	B,AVSLST
	JUMPE	A,FIN1
	MOVEM	A,AVSLST
FIN2:	MOVE	B,A
	HRRZ	A,(A)
	JUMPN	A,FIN2
FIN1:	MOVE	A,HEAD2
	JUMPE	A,FIN4
	HRRM	A,(B)
FIN3:	MOVE	B,A
	HRRZ	A,(A)
	JUMPN	A,FIN3
FIN4:	HRRM	STYPTR,(B)
	POPJ	P,
;Subroutines: LATEST, SEQNBR.

;build up a list of the latest n stories, where n is a number typed in.
LATEST:	PUSHJ	P,INNBR		;read in nbr of stories to be found (CNT)
LAT1:	MOVEI	LIST3,SORDID+1(SORPTR)	;set up list ptr to header of list
	JUMPE	CNT,[CLRBFI
		     OUTSTR [ASCIZ /*** MISSING OR ZERO COUNT AFTER "." ***/]
		     JRST   RSTART]
	MOVE	X1,INDEX+1	;get index of NEW area
LAT3:	CAMN	X1,INDEX+2	;check if index has run into OLD
	JRST	LAT4		;it has.  no more stories can be retrieved
	SUBI	X1,XSIZE	;get previous index entry
	CAIGE	X1,SPECS
	MOVEI	X1,XLEN-XSIZE
	PUSHJ	P,GETAVL	;put this index entry onto list
	HRLM	X1,(LIST3)
	SOJG	CNT,LAT3	;have enough stories been found?
LAT4:	HLLZS	(LIST3)		;yes.  put null ptr at end of list
	JRST	GETCH1

;build up a list of the stories that have a given sequence number
SEQNBR:	PUSHJ	P,INNBR		;read in the seq nbr (CNT)
	MOVEM	CNT,SEQBEG
	CAIN	CHAR,":"	;is this a range of seq nbrs?
	PUSHJ	P,INNBR		;yes.  get seq nbr for end of range
	JUMPN	CNT,SEQ3	;if the end nbr is 0 and the
	SKIPE	SEQBEG		;	beginning nbr is not 0, then
	MOVEI	CNT,-1		;	∞ is used for the end nbr
SEQ3:	MOVEM	CNT,SEQEND
	SUB	CNT,SEQBEG
	MOVEI	LIST3,SORDID+1(SORPTR);set up list ptr to header of list
	MOVE	X1,INDEX+1	;get index of NEW area

SEQ1:	CAMN	X1,INDEX+2	;has the index run into OLD already?
	JRST	SEQ2		;yes.  that's all the stories there are
	SUBI	X1,XSIZE	;no.  get index of previous story
	CAIGE	X1,SPECS
	MOVEI	X1,XLEN-XSIZE
	HRRZ	A,INDEX+2(X1)	;get seq nbr for this story
	CAMGE	A,SEQBEG
	JRST	SEQ5
	JUMPL	CNT,SEQ4
	CAMLE	A,SEQEND
	JRST	SEQ1
	JRST	SEQ4
SEQ5:	JUMPGE	CNT,SEQ1
	CAMLE	A,SEQEND
	JRST	SEQ1

SEQ4:	PUSHJ	P,GETAVL	;yes.  add this story to the list
	HRLM	X1,(LIST3)
	JRST	SEQ1		;go look for more stories
SEQ2:	HLLZS	(LIST3)		;put null ptr at end of story list
	JRST	GETCH1
;Subroutines: GETSTY, INNBR, GETNBR, NXTDG, INTRPT.

GETSTY:	CAIE	CHAR,"*"	;does the user want to reference the oldest story?
	JRST	RDNBR		;no.  read in a story number
	MOVE	CNT,NFOUND	;yes.  get the number of the oldest story
	JRST	GETCHR
RDNBR:	SETZ	CNT,
RDNBR1:	CAIG	CHAR,"9"
	CAIGE	CHAR,"0"
	JRST	GETCR1
	IMULI	CNT,=10
	ADDI	CNT,-60(CHAR)
	INCHWL	CHAR
	JRST	RDNBR1

INNBR:	ILDB	CHAR,KXB	;load 1st char of number
GETNBR:	SETZ	CNT,		;CNT will hold the number typed in
NBR1:	CAIG	CHAR,"9"	;is this character a digit?
	CAIGE	CHAR,"0"
	JRST	GETCH1		;no.  return
	IMULI	CNT,=10		;yes.  multiply previous sum by =10
	ADDI	CNT,-60(CHAR)	;	and add in current digit
	ILDB	CHAR,KXB	;load the next potential digit
	JRST	NBR1

PRNTNO:	MOVE	B,[POINT 7,DIGITS]
	PUSHJ	P,NXTDG
	SETZ	PART1,
	IDPB	PART1,B
	OUTSTR	DIGITS
	POPJ	P,

NXTDG:	IDIVI	PART1,=10
	PUSH	P,PART2
	SKIPE	PART1
	PUSHJ	P,NXTDG
	POP	P,PART1
	ADDI	PART1,60
	IDPB	PART1,B
	POPJ	P,

INTRPT:	SKIPN	INTABL		;user typed [ESC] I
	CALLI	400024		;DISMIS: cannot interrupt now
	SETZM	INTABL		;disable further interrupts on [ESC] I
	SETZM	STORY
	MOVE	A,[XWD STORY,STORY+1]
	BLT	A,STORY+STLEN-1
	CALLI	400034		;UWAIT: wait for any UUO in progress to finish
	JRST@	2,[.+1]
	CLRBFI
	CALLI	400035		;DEBREAK: make this PC the user level PC
	OUTSTR	[ASCIZ /

↑I
/]
	CALLI	0		;RESET: throw away output file if open
	HRLZI	A,4		;enable for interrupts on [ESC] I again
	CALLI	A,400025	;INTENB
	JRST	RSTART
;Subroutines: PUTDAT.

PUTDAT:
IFG ULEN <
	TLNE	FLAGS,GOD
	POPJ	P,		;dont record data for usage of APE by AP,SYS
	OPEN	15,DSK17
	ERRMSG	{OPEN FAILED ON DSK ()}
	MOVE	A,PPN
	MOVEM	A,USEF+3
	LOOKUP	15,USEF
	JRST	NOUSE
	OPEN	16,DSK17
	ERRMSG	{OPEN FAILED ON DSK ()}
	MOVE	A,PPN
	MOVEM	A,USEF+3
	ENTER	16,USEF		;ENTER new USE.DAT with old creation date/time
	JRST	NOUSE
	IN	15,UCMD
	JRST	.+2
	JRST	NOUSE
	MOVEI	CNT,ULEN-2
NXTU:	MOVE	A,LOCDAT(CNT)
	ADDM	A,TOTDAT(CNT)	;add local data to grand totals kept in USE.DAT
	SOJG	CNT,NXTU
	OUT	16,UCMD
	JRST	.+2
	JRST	NOUSE
	RELEAS	15,
	RELEAS	16,
CLEARU:	SETZM	LOCDAT
IFG ULEN-1 <
	MOVE	A,[XWD LOCDAT,LOCDAT+1]
	BLT	A,LOCDAT+ULEN-1
>
	POPJ	P,

NOUSE:	RELEAS	15,3
	RELEAS	16,3
>
	POPJ	P,
;Subroutines: PRINTU. (Printing of statistics)

PRINTU:
IFG ULEN-2 <
	OPEN	15,DSK17
	ERRMSG	{OPEN FAILED ON DSK ()}
	MOVE	A,PPN
	MOVEM	A,USEF+3
	LOOKUP	15,USEF
	JRST	[RELEAS	15,
		 OUTSTR	[ASCIZ \TRY AGAIN LATER
\]
		 POPJ	P,]
	IN	15,UCMD
	JRST	.+2
	ERRMSG	{IN UUO FAILED FOR USE.DAT ()}
	RELEAS	15,

	OUTSTR	[ASCIZ \
DATA SINCE \]
	HLRZ	A,TOTDAT
	IDIVI	A,=60
	MOVE	PART1,A
	PUSHJ	P,PRNTNO		;print hour
	MOVE	PART1,A+1
	PUSHJ	P,PRNTNO		;print minutes
	OUTCHR	[" "]
	HRRZ	A,TOTDAT
	IDIVI	A,=31
	MOVEI	PART1,1(A+1)
	PUSHJ	P,PRNTNO		;print day of month
	IDIVI	A,=12
	OUTSTR	@MONTHS(A+1)		;print month
	MOVEI	PART1,=64(A)
	PUSHJ	P,PRNTNO		;print year
	OUTSTR	CRLF
	OUTSTR	CRLF
	MOVEI	C,ULEN-2
TOPU:	OUTSTR	@MSGDAT(C)
	MOVE	PART1,TOTDAT(C)
	MOVE	B,[POINT 7,DIGITS]
	PUSHJ	P,NXTDG
	SETZ	PART1,
	IDPB	PART1,B
	OUTSTR	DIGITS
	OUTSTR	CRLF
	SOJG	C,TOPU
>
	OUTSTR	CRLF
	POPJ	P,

ZEROUS:	OUTSTR	[ASCIZ \CLEAR? \]
	INCHRW	A
	CAIE	A,"%"
	POPJ	P,
	INCHRW	A
	CAIE	A,"π"
	POPJ	P,
	OPEN	16,DSK17
	ERRMSG	{OPEN FAILED ON DSK ()}
	HLLZS	USEF+1
	SETZM	USEF+2
	MOVE	A,PPN
	MOVEM	A,USEF+3
	ENTER	16,USEF
	JRST	[RELEAS 16,
		 OUTSTR	[ASCIZ \ FAILED
\]
		 POPJ	P,]
	CALLI	A,14			;DATE
	HRRZM	A,TOTDAT
	CALLI	A,22			;TIMER
	IDIVI	A,=3600			;convert time to minutes
	HRLM	A,TOTDAT
	SETZM	TOTDAT+1
IFG ULEN-2 <
	MOVE	A,[XWD TOTDAT+1,TOTDAT+2]
	BLT	A,TOTDAT+ULEN-1
>
	OUT	16,UCMD
	JRST	.+2
	ERRMSG	{OUT UUO FAILED FOR USE.DAT ()}
	RELEAS	16,
	OUTSTR	[ASCIZ \ DONE\]
	POPJ	P,
;Subroutines: SAVPPN.

SAVPPN:	OPEN	14,DSK17
	ERRMSG	{CANT OPEN DSK! ()}
	MOVE	B,PPN
	MOVEM	B,USERSF+3
	LOOKUP	14,USERSF
	JRST	XPPN
	HLRE	A,USERSF+3
	MOVE	B,PPN
	MOVEM	B,USERSF+3
	ENTER	14,USERSF
	JRST	XPPN
	MOVN	A,A
	LDB	B,[POINT 7,A,35]
	ASH	A,-7
	JUMPE	B,WRT
	USETI	14,1(A)
	MOVN	C,B
	HRLM	C,PCMD
	IN	14,PCMD
	JRST	.+2
	JRST	XPPN
WRT:	USETO	14,1(A)
	LDB	A,[POINT 6,USRPPN,23]
	TRCE	A,40
	TRO	A,100			;convert PPN from SIXBIT to ASCII
	DPB	A,[POINT 7,USERS(B),6]
	LDB	A,[POINT 6,USRPPN,29]
	TRCE	A,40
	TRO	A,100
	DPB	A,[POINT 7,USERS(B),13]
	LDB	A,[POINT 6,USRPPN,35]
	TRCE	A,40
	TRO	A,100
	DPB	A,[POINT 7,USERS(B),20]
	MOVEI	A," "			;put a space after the PPN
	DPB	A,[POINT 14,USERS(B),34]
	SETZM	USERS+1(B)
	MOVNI	B,2(B)
	HRLM	B,PCMD
	OUTPUT	14,PCMD
	TLO	FLAGS,PPNDUN
XPPN:	RELEAS	14,
	POPJ	P,

	END	APE